home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / encrypt.pas < prev    next >
Pascal/Delphi Source File  |  1993-04-14  |  6KB  |  124 lines
  1. unit Encrypt;
  2.  
  3. {****************************************************************************
  4. *****************************************************************************
  5. *                                                                           *
  6. *  EncryptString encrypts a string in the same way as Windows' ScreenSaver  *
  7. *  library does. The same function will be available as a DLL in CLMFORUM,  *
  8. *  Lib 9.                                                                   *
  9. *                                                                           *
  10. *  Published in WinTech Journal, February 1993.                             *
  11. *                                                                           *
  12. *****************************************************************************
  13. *                                                                           *
  14. *  Written by Manfred Keul [100031,12].                                     *
  15. *                                                                           *
  16. *  Compiler: Turbo Pascal for Windows 1.5                                   *
  17. *                                                                           *
  18. *****************************************************************************
  19. *                                                                           *
  20. *  Rev. 0.1   28.3.93   MK  IR                                              *
  21. *                                                                           *
  22. *****************************************************************************
  23. ****************************************************************************}
  24.  
  25. interface
  26.  
  27. uses WinProcs;
  28.  
  29. procedure EncryptString (Strg: PChar);
  30.  
  31. implementation
  32.  
  33. {****************************************************************************
  34. *                                                                           *
  35. *                      E n c r y p t S t r i n g                            *
  36. *                                                                           *
  37. *   Encrypts (password-) string the way Windows' ScreenSaver does           *
  38. *                                                                           *
  39. *   INPUT : Strg = string to encrypt                                        *
  40. *                                                                           *
  41. *   OUTPUT: Strg = encrypted string                                         *
  42. *                                                                           *
  43. ****************************************************************************}
  44.  
  45.  
  46. procedure EncryptString (Strg: PChar);
  47.  
  48.  
  49. {***----------------------------------------------------------------------***
  50. *                                                                           *
  51. *                              E x o r                                      *
  52. *                                                                           *
  53. *   local to EncryptString: xors two bytes, tests and stores result         *
  54. *                                                                           *
  55. *   INPUT : x1, x2 = bytes to be xored                                      *
  56. *                                                                           *
  57. *   OUTPUT: x2 = x1 xor x2, if the resulting x2 isn't one of the            *
  58. *                                               "special cases" (see code)  *
  59. *              else x2 unmodified                                           *
  60. *                                                                           *
  61. *   NOTE  : Using a handful of compares probably would be faster than       *
  62. *           testing on set membership - which, however, is more elegant.    *
  63. *                                                                           *
  64. ***----------------------------------------------------------------------***}
  65.  
  66. procedure Exor (x1: byte; var x2: byte);
  67.  
  68. const NotAllowed = [0..$20, $7f..$90, $93..$9f, $3d, $5b, $5d];
  69.                    { the last three are '[]=' - not allowed in profile string }
  70. begin
  71. if not ((x2 xor x1) in NotAllowed) then
  72.     x2 := x2 xor x1;
  73. end; { Exor }
  74.  
  75.  
  76. {***------------------ Start of EncryptString ----------------------------***}
  77.  
  78. var   StrgPt, TheByte, StrgLg: byte;
  79.  
  80. begin
  81. StrgLg := Byte(lstrlen(Strg));
  82. if (StrgLg = 0) then exit;      { empty string => nothing to do }
  83. AnsiUpper (Strg);               { capitalize the string }
  84.  
  85.  
  86. {================================ First Pass ==================================}
  87.  
  88. for StrgPt := 0 to StrgLg-1 do                    { proceed from left to right }
  89.       begin
  90.       TheByte := byte (Strg [StrgPt]);              { get character to encrypt }
  91.       Exor (StrgLg, TheByte);                   { xor it using string length...}
  92.       if (StrgPt = 0) then
  93.             Exor ($2a, TheByte)                               {...a constant...}
  94.         else
  95.             begin
  96.             Exor (StrgPt, TheByte);                {...actual string pointer...}
  97.             Exor (byte (Strg [StrgPt-1]), TheByte);     {...previous character }
  98.             end;
  99.       Strg [StrgPt] := char (TheByte);             { store encrypted byte back }
  100.       end; { for };
  101.  
  102.  
  103. {=============================== Second Pass ==================================}
  104.  
  105. if (StrgLg > 1) then                     { no second pass for one-byte-strings }
  106.    for StrgPt := StrgLg-1 downto 0 do             { proceed from right to left }
  107.        begin                               {  encrypt similar as in first pass }
  108.        TheByte := byte (Strg [StrgPt]);
  109.        Exor (StrgLg, TheByte);
  110.        if (StrgPt = StrgLg - 1) then
  111.              Exor ($2a, TheByte)
  112.          else
  113.              begin
  114.              Exor (StrgPt, TheByte);
  115.              Exor (byte (Strg [StrgPt+1]), TheByte);
  116.              end;
  117.        Strg [StrgPt] := char (TheByte);            { store encrypted byte back }
  118.        end; { for };
  119.  
  120. end; { EncryptString }
  121.  
  122. begin
  123. end.
  124.